home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-04 / gs24src.zip / WRFONT.PS < prev    next >
Text File  |  1992-01-31  |  8KB  |  274 lines
  1. %    Copyright (C) 1991 Aladdin Enterprises.  All rights reserved.
  2. %    Distributed by Free Software Foundation, Inc.
  3. %
  4. % This file is part of Ghostscript.
  5. %
  6. % Ghostscript is distributed in the hope that it will be useful, but
  7. % WITHOUT ANY WARRANTY.  No author or distributor accepts responsibility
  8. % to anyone for the consequences of using it or for whether it serves any
  9. % particular purpose or works at all, unless he says so in writing.  Refer
  10. % to the Ghostscript General Public License for full details.
  11. %
  12. % Everyone is granted permission to copy, modify and redistribute
  13. % Ghostscript, but only under the conditions described in the Ghostscript
  14. % General Public License.  A copy of this license is supposed to have been
  15. % given to you along with Ghostscript so you can know your rights and
  16. % responsibilities.  It should be in a file named COPYING.  Among other
  17. % things, the copyright notice and this notice must be preserved on all
  18. % copies.
  19.  
  20. % wrfont.ps
  21. % Write out a Type 1 font in readable, reloadable form.
  22. % Note that this does NOT work on protected fonts, such as Adobe fonts
  23. % (unless you have loaded unprot.ps first, in which case you may be
  24. % violating the Adobe license).
  25.  
  26. % ------ Options ------ %
  27.  
  28. % Define whether to write out the CharStrings in binary or in hex.
  29. % Binary takes less space on the file, but isn't guaranteed portable.
  30.    /binary false def
  31.  
  32. % Define whether to use binary token encodings for the CharStrings.
  33. % Binary tokens are smaller and load faster, but are a Level 2 feature.
  34.    /binary_tokens false def
  35.  
  36. % ------ Output utilities ------ %
  37.  
  38. % By convention, the output file is named psfile.
  39.  
  40. % Define some utilities for writing the output file.
  41.    /wtstring 100 string def
  42.    /wb {psfile exch write} bind def
  43.    /wnb {/wb load repeat} bind def
  44.    /ws {psfile exch writestring} bind def
  45.    /wl {ws (\n) ws} bind def
  46.    /wt {wtstring cvs ws ( ) ws} bind def
  47.    /wd        % Write a dictionary.
  48.     { dup length wt (dict dup begin) wl { we } forall
  49.       (end) ws
  50.     } bind def
  51.    /wld        % Write a large dictionary more efficiently.
  52.            % Ignore the readonly attributes.
  53.     { dup length wt (dict dup begin) wl
  54.       0 exch
  55.        { exch wo wo
  56.      1 add dup 200 eq
  57.       { wo ({def} repeat) wl 0 }
  58.      if
  59.        }
  60.       forall
  61.       dup 0 ne
  62.        { wo ({def} repeat) wl }
  63.        { pop }
  64.       ifelse
  65.       (end) ws
  66.     } bind def
  67.    /we        % Write a dictionary entry.
  68.     { exch wo wo /def cvx wo (\n) ws
  69.     } bind def
  70.  
  71. % Construct the inversion of the system name table.
  72.    /SystemNames where
  73.     { pop /snit 256 dict def
  74.       0 1 255
  75.        { dup SystemNames exch get
  76.          dup null ne { exch snit 3 1 roll put } { pop pop } ifelse
  77.        }
  78.       for
  79.     }
  80.     { /snit 1 dict def
  81.     }
  82.    ifelse
  83.  
  84. % Write an object, using binary tokens if requested and possible.
  85.    /woa        % write in ascii
  86.     { psfile exch write==only
  87.     } bind def
  88.     % Lookup table for ASCII output.
  89.    /intbytes    % int nbytes -> byte*
  90.     { exch { dup 255 and exch -8 bitshift } repeat pop
  91.     } bind def
  92.    /wotta 8 dict dup begin
  93.     { /booleantype /integertype /nulltype /realtype }
  94.     { { ( ) ws woa } def }
  95.    forall
  96.      /nametype
  97.       { dup xcheck { ( ) ws } if woa
  98.       } bind def
  99.     { /arraytype /packedarraytype /stringtype }
  100.     { { dup woa wop } def }
  101.    forall
  102.    end def
  103.     % Lookup table for binary output.
  104.    /wottb 8 dict dup begin
  105.    wotta currentdict copy pop
  106.      /integertype
  107.       { dup dup 127 le exch -128 ge and
  108.          { 136 wb 255 and wb
  109.      }
  110.      { ( ) ws woa
  111.      }
  112.     ifelse
  113.       } bind def
  114.      /nametype
  115.       { dup snit exch known
  116.          { dup xcheck { 146 } { 145 } ifelse wb
  117.        snit exch get wb
  118.      }
  119.      { wotta /nametype get exec
  120.      }
  121.     ifelse
  122.       } bind def
  123.      /stringtype
  124.       { dup dup length dup 255 le { 142 2 } { 2 intbytes 143 3 } ifelse wnb
  125.         ws wop
  126.       } bind def
  127.    end def
  128.    /wop        % Write object protection
  129.      { wcheck not { /readonly cvx wo } if
  130.      } bind def
  131.    /wo        % Write an object.
  132.      { dup type binary_tokens { wottb } { wotta } ifelse
  133.        exch get exec
  134.      } bind def
  135.  
  136. % Write a hex string for Subrs or CharStrings.
  137.    /wx        % string ->
  138.     { binary
  139.        { ws
  140.        }
  141.        { % Some systems choke on very long lines, so
  142.      % we break up the hexstring into chunks of 50 characters.
  143.       { dup length 25 le {exit} if
  144.         dup 0 25 getinterval psfile exch writehexstring (\n) ws
  145.         dup length 25 sub 25 exch getinterval
  146.       } loop
  147.      psfile exch writehexstring
  148.        } ifelse
  149.     } bind def
  150.  
  151. % ------ The main program ------ %
  152.  
  153. % Define the dictionary of actions for special entries in the dictionaries.
  154. % We lump the font and the Private dictionary together, because
  155. % the set of keys doesn't overlap.
  156. [/CharStrings /Encoding /FID /FontInfo /Metrics /Private /Subrs]
  157. dup length dict begin
  158.  { null cvx def } forall
  159. currentdict end /specialkeys exch def
  160.  
  161. % Define the procedures for the Private dictionary.
  162. % These must be defined without being bound.
  163. 4 dict begin
  164.  /-! {string currentfile exch readhexstring pop} def
  165.  /-| {string currentfile exch readstring pop} def
  166.  /|- {readonly def} def
  167.  /| {readonly put} def
  168. currentdict end /privateprocs exch def
  169.  
  170. % Construct an inverse dictionary of encodings.
  171. 3 dict begin
  172.  StandardEncoding /StandardEncoding def
  173.  ISOLatin1Encoding /ISOLatin1Encoding def
  174.  SymbolEncoding /SymbolEncoding def
  175. currentdict end /encodingnames exch def
  176.  
  177. /writefont        % psfile -> [writes the current font]
  178.  { /psfile exch def
  179.    /Font currentfont def
  180.    /readproc binary { (-| ) } { (-! ) } ifelse def
  181.  
  182. % Turn on binary tokens if relevant.
  183.    binary_tokens { (currentobjectformat 1 setobjectformat) wl } if
  184.  
  185. % If the file has a UniqueID, write out a check against loading it twice.
  186.    Font /UniqueID known
  187.     { ({} FontDirectory) ws Font /FontName get dup wo ( known) wl
  188.       ( {) ws wo ( findfont dup /UniqueID known) wl
  189.       (    { dup /UniqueID get) ws Font /UniqueID get wo ( eq exch /FontType get 1 eq and }) wl
  190.       (    { pop false } ifelse) wl
  191.       (    { pop save /restore load } if) wl
  192.       ( } if) wl
  193.     }
  194.    if
  195.  
  196. % Write out the creation of the font dictionary and FontInfo.
  197.    Font length 1 add wt (dict begin) wl        % +1 for FontFile
  198.    Font begin
  199.    (/FontInfo ) ws FontInfo wd ( readonly def) wl
  200.  
  201. % Write out the other fixed entries in the font dictionary.
  202.    Font
  203.     { 1 index specialkeys exch known
  204.        { pop pop } { we } ifelse
  205.     } forall
  206.    /Encoding
  207.    encodingnames Encoding known
  208.     { encodingnames Encoding get cvx }
  209.     { Encoding }
  210.    ifelse we
  211.  
  212. % Write out the Metrics, if any.
  213.    Font /Metrics known
  214.     { (/Metrics ) ws Metrics wld ( readonly def) wl
  215.     }
  216.    if
  217.  
  218. % Close the font dictionary.
  219.    (currentdict end) wl
  220.  
  221. % The rest of the file could be in eexec form, but we don't see any point
  222. % in doing this, because we aren't attempting to conceal it from anyone.
  223.  
  224. % Create and initialize the Private dictionary.
  225.    Private dup length privateprocs length add dict copy begin
  226.    privateprocs { readonly def } forall
  227.    (dup /Private ) ws currentdict length 1 add wt (dict dup begin) wl
  228.    currentdict
  229.     { 1 index specialkeys exch known
  230.        { pop pop } { we } ifelse
  231.     } forall
  232.  
  233. % Write the Subrs entries, if any.
  234.    currentdict /Subrs known
  235.     { (/Subrs ) ws Subrs length wt (array) wl
  236.       0 1 Subrs length 1 sub
  237.        { dup Subrs exch get dup null ne
  238.       { /dup cvx wo exch wo dup length wo ( ) ws readproc ws wx ( |) wl }
  239.       { pop pop }
  240.      ifelse
  241.        } for
  242.       (readonly def) wl
  243.     }
  244.    if
  245.  
  246. % Write the CharStrings entries.
  247.    (2 index /CharStrings ) ws
  248.    CharStrings length wt (dict dup begin) wl
  249.    CharStrings
  250.     { exch wo
  251.       binary_tokens
  252.        { % Suppress recognizing the readonly status of the string.
  253.          dup length string copy wo
  254.        }
  255.        { dup length wo ( ) ws readproc ws wx
  256.        }
  257.       ifelse ( |-) wl
  258.     } forall
  259.  
  260. % Wrap up the private part of the font.
  261.    (end) wl        % CharStrings
  262.    (end) wl        % Private
  263.    end            % Private
  264.    (readonly put) wl    % CharStrings in font
  265.    (readonly put) wl    % Private in font
  266.    end            % Font
  267.  
  268. % Terminate the output.
  269.    (dup /FontName get exch definefont pop) wl
  270.    Font /UniqueID known { (exec) wl } if
  271.    binary_tokens { (setobjectformat) wl } if
  272.  
  273.  } bind def
  274.